unit xDBButton;

interface

uses
  WinProcs, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Messages,
  StdCtrls, ExtCtrls, Buttons, DB, Menus, cxButtons;

type
 TDBButtonType = (
    nbCustom,
    nbFirst, nbPrior, nbNext, nbLast,
    nbInsert, nbAppend, nbDelete,
    nbEdit,
    nbPost, nbCancel,
    nbRefresh);

  TDBButtonLanguage = (
    blUSEnglish);

  TDBBDisableReason = (
    drBOF, drEOF, drReadonly,
    drNotEditing, drEditing, drEmpty);
  TDBBDisableReasons = set of TDBBDisableReason;

  TGetQuestionEvent =
    procedure (Sender: TObject;
               var Question: string;
               var Buttons: Integer) of object;

  TBeforeActionEvent =
    procedure (Sender: TObject; var ActionIsDone: Boolean) of object;

  TAfterActionEvent =
    procedure (Sender: TObject; var Error: Boolean) of object;

const
  { Caption / Hint: }
  BtnCaption: array[TDBButtonLanguage, TDBButtonType] of string[15] =
  (
  { USEnglish: }
    ('', 'First', 'Prior', 'Next', 'Last', 'New', 'Append', 'Delete', 'Edit',
     'Save', 'Cancel', 'Refresh')
   );

  StandardDBBLanguage = blUSEnglish;


  LastSelectedDBBLanguage: TDBButtonLanguage = StandardDBBLanguage;

  { Component.Name: }
  BtnName: array[TDBButtonType] of string =
    ('', 'First', 'Prior', 'Next', 'Last',
     'New', 'Append', 'Delete', 'Edit',
     'Save', 'Cancel', 'Refresh');

  { for internal use: }
  BtnTypeName: array[TDBButtonType] of PChar =
    ('', 'FIRST', 'PRIOR', 'NEXT', 'LAST',
     'INSERT', 'APPEND', 'DELETE', 'EDIT',
     'POST', 'CANCEL', 'REFRESH');

  BtnNeedsTimer: array[TDBButtonType] of Boolean =
    (False, False, True, True, False,
     False, False, False, False,
     False, False, False);

type
  { TDBBtnDataLink }
  TEvent = procedure of object;

  TDBBtnDataLink = class(TDataLink)
  private
    FOnEditingChanged: TEvent;
    FOnDataSetChanged: TEvent;
    FOnActiveChanged: TEvent;
  protected
    procedure EditingChanged; override;
    procedure DataSetChanged; override;
    procedure ActiveChanged; override;
  public
    constructor Create;
    property OnEditingChanged: TEvent
      read FOnEditingChanged write FOnEditingChanged;
    property OnDataSetChanged: TEvent
      read FOnDataSetChanged write FOnDataSetChanged;
    property OnActiveChanged: TEvent
      read FOnActiveChanged write FOnActiveChanged;
  end;
  { TxCustomDBButton }
  TxCustomDBButton = class(TcxButton)
  private
    FDisableReasons: TDBBDisableReasons;
    FDataLink: TDBBtnDataLink;
    FMenuItem: TMenuItem;
    FOnMenuItemClick: TNotifyEvent;
    FConfirmDelete: Boolean;
    FButtonEnabled: Boolean;
    FDBButtonType: TDBButtonType;
    FLanguage: TDBButtonLanguage;
    FOnBeforeAction: TBeforeActionEvent;
    FOnGetQuestion: TGetQuestionEvent;
    FOnEnabledChanged: TNotifyEvent;
    FRepeatTimer: TTimer;
    FInProcUpdateEnabled: Boolean;
    function GetDataSource: TDataSource;
    procedure SetDataSource(Value: TDataSource);
    procedure SetDBButtonType(Value: TDBButtonType);
    procedure SetLanguage(Value: TDBButtonLanguage);
    procedure SetMenuItem(Value: TMenuItem);
    procedure MenuItemClick(Sender: TObject);
    procedure ReadButtonEnabled(Reader: TReader);
    procedure WriteButtonEnabled(Writer: TWriter);
    function NumberOfStandardComponentName: Integer;
    function HasStandardComponentName: Boolean;
    function CalculateComponentName(NewButtonType: TDBButtonType;
      var NewName: TComponentName): Boolean;
    procedure CalcDisableReasons;
    function StandardComponentName: TComponentName;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  protected
    FOnAfterAction: TAfterActionEvent;
    procedure Loaded; override;
    procedure DefineProperties(Filer: TFiler); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function CtrlNamePrefix: string; virtual;
    procedure DoGetQuestion(var Question: string; var Buttons: Integer); virtual;
    function DoAskQuestion: Boolean; virtual;

    {   Calculates property Enabled: }
    procedure UpdateEnabled; virtual;

    {   DoBeforeAction Calls the OnBeforeAction event: }
    procedure DoBeforeAction(var ActionIsDone: Boolean); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Click; override;

{   DoAction Calls DoBeforeAction.
    Then it performs the standard-action if DataButtonType <> nbCustom.
    Same as Click, but it does not call the OnClick event: }
    procedure DoAction; virtual;
  protected
    property ConfirmDelete: Boolean read FConfirmDelete write FConfirmDelete;
    property DataButtonType: TDBButtonType read FDBButtonType write SetDBButtonType;
    property Language: TDBButtonLanguage read FLanguage write SetLanguage;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property MenuItem: TMenuItem read FMenuItem write SetMenuItem;
    property OnGetQuestion: TGetQuestionEvent read FOnGetQuestion write FOnGetQuestion;
    property OnBeforeAction: TBeforeActionEvent read FOnBeforeAction write FOnBeforeAction;
    property OnAfterAction: TAfterActionEvent read FOnAfterAction write FOnAfterAction;
    property DisableReasons: TDBBDisableReasons read FDisableReasons write FDisableReasons;
    property OnEnabledChanged: TNotifyEvent read FOnEnabledChanged write FOnEnabledChanged;
  end;


  { TxDBButton }
  TxDBButton = class(TxCustomDBButton)
  published
    property ConfirmDelete default True;
    property DataButtonType;
    property Language default StandardDBBLanguage;
    property DataSource;
    property MenuItem;

{   Use OnGetQuestion if you want to ask the user before the action
    gets performed: }
    property OnGetQuestion;

{   Use BeforeAction instead of the Click-event if you want to be able to
    cancel the default-action by setting ActionIsDone to true.
    The Click-event is called before the DoAction-event. }
    property OnBeforeAction;

    property OnAfterAction;

{   Use DisableReasons to say on what case the button has to be disabled.
    It is set automatic if you set DataButtonType <> nbCustom.
    DisableReason  | Disable if Dataset is...
    ---------------+-------------------------
      drBOF        | EOF
      drEOF        | BOF
      drReadonly   | Readonly
      drNotEditing | Not in insert or edit-mode
      drEditing    | In insert or edit-mode
      drEmpty      | Both BOF and EOF }
    property DisableReasons;

{   Called after Enabled has changed: }
    property OnEnabledChanged;
  end;

function IsStandardBtnCaption(s: string; Language: TDBButtonLanguage): Boolean;
procedure Register;

implementation

uses
  xConsts;

  { Register}
procedure Register;
begin
  RegisterComponents(SxVCLPalette, [TxDBButton]);
end;

function IsStandardBtnCaption(s: string; Language: TDBButtonLanguage): Boolean;
var
  DBButtonType: TDBButtonType;
begin
  for DBButtonType := Low(TDBButtonType) to High(TDBButtonType) do
    if (BtnCaption[Language, DBButtonType] = s) then
    begin
      result := true;
      exit;
    end;
  result := false;
end;

{ TxCustomDBButton }

constructor TxCustomDBButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataLink := TDBBtnDataLink.Create;
  with FDataLink do
  begin
    OnEditingChanged := UpdateEnabled;
    OnDataSetChanged := UpdateEnabled;
    OnActiveChanged := UpdateEnabled;
  end;
  DataButtonType := nbCustom;
  FLanguage := LastSelectedDBBLanguage;
  FConfirmDelete := True;
  FButtonEnabled := True;
  FDisableReasons := [];
  FRepeatTimer := nil;
  FMenuItem:= nil;
  FOnGetQuestion:= nil;
  FOnBeforeAction:= nil;
  FOnAfterAction:= nil;
  FInProcUpdateEnabled := false;
end;

destructor TxCustomDBButton.Destroy;
begin
  if (FRepeatTimer <> nil) then
    FRepeatTimer.Free;
  FDataLink.Free;
  FDataLink := nil;
  MenuItem:= nil;
  inherited Destroy;
end;

procedure TxCustomDBButton.CalcDisableReasons;
begin
  case FDBButtonType of
    nbPrior: FDisableReasons := [drBOF, drEditing, drEmpty];
    nbNext: FDisableReasons := [drEOF, drEditing, drEmpty];
    nbFirst: FDisableReasons := [drBOF, drEditing, drEmpty];
    nbLast: FDisableReasons := [drEOF, drEditing, drEmpty];
    nbInsert, nbAppend: FDisableReasons := [drReadonly, drEditing];
    nbEdit: FDisableReasons := [drReadonly, drEditing, drEmpty];
    nbCancel: FDisableReasons := [drNotEditing];
    nbPost: FDisableReasons := [drNotEditing];
    nbRefresh: FDisableReasons := [drEditing];
    nbDelete: FDisableReasons := [drReadonly, drEditing, drEmpty];
  end;
end;

function TxCustomDBButton.StandardComponentName: TComponentName;
begin
{ returns the classname without 'T' at begin, functions with decendants too: }
  Result := ClassName; { 'TDBSpeedButton' }
  if (Upcase(Result[1]) = 'T') then
    System.Delete(Result, 1, 1); { 'DBSpeedButton' }
end;

function TxCustomDBButton.NumberOfStandardComponentName: Integer;
function NumberOfName(const TestName: TComponentName): Integer;
begin
  if (Length(Name) > Length(TestName)) and
     (Copy(Name, 1, Length(TestName)) = TestName) then
  begin
    try
      Result := StrToInt(Copy(Name, Length(TestName) + 1, 255));
    except
      Result := 0;
    end;
  end
  else
    Result := 0;
end; { function NumberOfName }
begin { TCustomDBBmpButton.NumberOfStandardComponentName }
  Result := NumberOfName(StandardComponentName);
  if (Result = 0) then
    Result := NumberOfName(CtrlNamePrefix + BtnName[FDBButtonType]);
end;

function HasName(const Name, TestName: TComponentName): Boolean;
begin
  if (Length(Name) > Length(TestName)) and
     (Copy(Name, 1, Length(TestName)) = TestName) then
  begin
    try
      Result := (StrToInt(Copy(Name, Length(TestName) + 1, 255)) > 0);
    except
      Result := false;
    end;
  end
  else
    Result := (Name = TestName);
end;

function TxCustomDBButton.HasStandardComponentName: Boolean;
begin
  Result :=
    HasName(Name, StandardComponentName) or
    HasName(Name, CtrlNamePrefix + BtnName[FDBButtonType]);
end;

function TxCustomDBButton.CalculateComponentName(
  NewButtonType: TDBButtonType;
  var NewName: TComponentName): Boolean;
const
  TooMuch_SomethingIsWrong = 66;
var
  Number: Integer;
begin
  Result := false;
  try { ... to find new name for the component: }
    if HasStandardComponentName then
    begin
      if (NewButtonType = nbCustom) then
        NewName := StandardComponentName + '1'
      else
        NewName := CtrlNamePrefix + BtnName[NewButtonType];
      if (Owner <> nil) and (Owner.FindComponent(NewName) <> nil) then
      begin
        Number := NumberOfStandardComponentName;
        if (Number = 0) then
          Number := 1;
        repeat
          if (NewButtonType = nbCustom) then
            NewName := StandardComponentName + IntToStr(Number)
          else
            NewName := CtrlNamePrefix + BtnName[NewButtonType] +
                       IntToStr(Number);
          Inc(Number);
        until (Owner.FindComponent(NewName) = nil) or
              (Number = TooMuch_SomethingIsWrong);
        { Number = TooMuch_SomethingIsWrong should never happen, but I
          don't want to risk an endless loop in design-mode. }
        Result := (Number <> TooMuch_SomethingIsWrong) and (NewName <> Name);
      end
      else
        Result := (NewName <> Name);
    end;
  except
  { don't change name if error occured, no warning }
  end;
end;

procedure TxCustomDBButton.SetDBButtonType(
  Value: TDBButtonType);
var
  NewName: TComponentName;
begin
  if (Value = FDBButtonType) then
    exit;
  if (csDesigning in ComponentState) and
     CalculateComponentName(Value, NewName) then
    Name := NewName;
  if (csReading in ComponentState) or (csLoading in ComponentState) then
  begin
    FDBButtonType := Value;
    CalcDisableReasons;
    exit;
  end;
  Enabled := True;
{ Spacing := -1; }
  if (Value <> nbCustom) then
  begin
    if (Caption = '') or IsStandardBtnCaption(Caption, FLanguage) then
    { Change caption if it was created by us automatically: }
      Caption := BtnCaption[FLanguage, Value];
  end;
  Enabled := False;
  Enabled := True;
  FDBButtonType := Value;
  CalcDisableReasons;
end;

procedure TxCustomDBButton.SetLanguage(Value: TDBButtonLanguage);
begin
  if (Value = FLanguage) then
    exit;
  if (FDBButtonType <> nbCustom) then
  begin
    if (Caption = '') or IsStandardBtnCaption(Caption, FLanguage) then
    { Change caption if it was created by us automatically: }
      Caption := BtnCaption[Value, FDBButtonType];
  end;
  FLanguage := Value;
end;

procedure TxCustomDBButton.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
     (AComponent = DataSource) then
    DataSource := nil;
  if (Operation = opRemove) and (AComponent = FMenuItem) then
    MenuItem := nil;
end;

procedure TxCustomDBButton.DoBeforeAction(var ActionIsDone: Boolean);
begin
  if (not (csDesigning in ComponentState)) and
     Assigned(FOnBeforeAction) then
    FOnBeforeAction(self, ActionIsDone);
end;

procedure TxCustomDBButton.DoGetQuestion(var Question: string; var Buttons: Integer);
begin
  if (FDBButtonType = nbDelete) and FConfirmDelete then
    Question := SxDeleteText
  else
    Question := '';
  Buttons := MB_OKCANCEL + MB_ICONQUESTION;
  if Assigned(FOnGetQuestion) then
    FOnGetQuestion(Self, Question, Buttons);
end;

function TxCustomDBButton.DoAskQuestion: Boolean;
var
  Question: string;
  QuestionButtons: Integer;
  QuestionResult: Longint;
begin
  DoGetQuestion(Question, QuestionButtons);
  if (Question <> '') then
  begin
    QuestionResult := Application.MessageBox(PChar(Question), SxVCLQuestionCaption, QuestionButtons);
    Result := (QuestionResult = idOk) or (QuestionResult = idYes);
  end
  else
    Result := True;
end;

procedure TxCustomDBButton.DoAction;
var
  DataSet: TDataSet;
  Cancel: Boolean;
  Error: Boolean;
begin
  if not DoAskQuestion then
    exit;
  Cancel := (FDBButtonType = nbCustom);
  try
    DoBeforeAction(Cancel);
    if (not Cancel) and (DataSource <> nil) and
       (DataSource.State <> dsInactive) then
    begin
      DataSet := DataSource.DataSet;
      with DataSet do
      begin
        case FDBButtonType of
          nbPrior: Prior;
          nbNext: Next;
          nbFirst: First;
          nbLast: Last;
          nbInsert: Insert;
          nbAppend: Append;
          nbEdit: Edit;
          nbCancel: Cancel;
          nbPost: Post;
          nbRefresh: Refresh;
          nbDelete: Delete;
        end;
      end;
    end;
    Error := false;
  except
    if Assigned(FOnAfterAction) then
    begin
      Error := true;
      FOnAfterAction(self, Error);
    end;
    if Error then
      raise;
    Error := true;
  end;
  if not Error and Assigned(FOnAfterAction) then
    FOnAfterAction(self, Error);
end;

procedure TxCustomDBButton.Click;
begin
  inherited Click;
  DoAction;
end;

procedure TxCustomDBButton.UpdateEnabled;
var
  PossibleDisableReasons: TDBBDisableReasons;
  WasEnabled: Boolean;
begin
  if (csDesigning in ComponentState) then
    Exit;
  if (csDestroying in ComponentState) then
    Exit;
  if not FButtonEnabled then
    Exit;
  FInProcUpdateEnabled := true;
  try
    WasEnabled := Enabled;
    if FDataLink.Active then
    begin
    PossibleDisableReasons := [];
    if FDataLink.DataSet.BOF then
      Include(PossibleDisableReasons, drBOF);
    if FDataLink.DataSet.EOF then
      Include(PossibleDisableReasons, drEOF);
    if not FDataLink.DataSet.CanModify then
      Include(PossibleDisableReasons, drReadonly);
    if FDataLink.DataSet.BOF and FDataLink.DataSet.EOF then
      Include(PossibleDisableReasons, drEmpty);
    if FDataLink.Editing then
      Include(PossibleDisableReasons, drEditing)
    else
      Include(PossibleDisableReasons, drNotEditing);
    Enabled := (FDisableReasons * PossibleDisableReasons = []);
    end
    else
      Enabled := false;
    FButtonEnabled := true;
    if FMenuItem <> nil then
      FMenuItem.Enabled:= Enabled;
    if (WasEnabled <> Enabled) and Assigned(FOnEnabledChanged) then
      FOnEnabledChanged(self);
  finally
    FInProcUpdateEnabled := false;
  end;
end;

procedure TxCustomDBButton.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  if (not FInProcUpdateEnabled) and
     (not (csLoading in ComponentState)) and
     (not (csDestroying in ComponentState)) then
  begin
    FButtonEnabled := Enabled;
    UpdateEnabled;
  end;
end;

procedure TxCustomDBButton.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
  if not (csLoading in ComponentState) then
    UpdateEnabled;
  if Value <> nil then
    Value.FreeNotification(Self);
end;

function TxCustomDBButton.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TxCustomDBButton.ReadButtonEnabled(Reader: TReader);
begin
  FButtonEnabled := Reader.ReadBoolean;
end;

procedure TxCustomDBButton.WriteButtonEnabled(Writer: TWriter);
begin
  Writer.WriteBoolean(FButtonEnabled);
end;

procedure TxCustomDBButton.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('RuntimeEnabled', ReadButtonEnabled, WriteButtonEnabled, True);
end;

procedure TxCustomDBButton.Loaded;
begin
  inherited Loaded;
  Enabled := FButtonEnabled;
  UpdateEnabled;
end;

procedure TxCustomDBButton.SetMenuItem(Value: TMenuItem);
begin
  if (Value <> FMenuItem) then
  begin
    if not (csDesigning in ComponentState) then
    begin
      if Assigned(FMenuItem) and
         not (csDestroying in FMenuItem.ComponentState) then
        FMenuItem.OnClick := FOnMenuItemClick;
      if Assigned(Value) then
      begin
        FOnMenuItemClick := Value.OnClick;
        Value.OnClick := MenuItemClick;
      end
      else
        FOnMenuItemClick := nil;
    end;
    FMenuItem := Value;
  end;
end;

procedure TxCustomDBButton.MenuItemClick(Sender: TObject);
begin
  Click;
  if Assigned(FOnMenuItemClick) then
    FOnMenuItemClick(Sender);
end;

function TxCustomDBButton.CtrlNamePrefix: string;
begin
  Result := 'btn';
end;

{ TDBBtnDataLink }

constructor TDBBtnDataLink.Create;
begin
  inherited Create;
  FOnEditingChanged := nil;
  FOnDataSetChanged := nil;
  FOnActiveChanged := nil;
end;

procedure TDBBtnDataLink.EditingChanged;
begin
  if Assigned(FOnEditingChanged) then FOnEditingChanged;
end;

procedure TDBBtnDataLink.DataSetChanged;
begin
  if Assigned(FOnDataSetChanged) then FOnDataSetChanged;
end;

procedure TDBBtnDataLink.ActiveChanged;
begin
  if Assigned(FOnActiveChanged) then FOnActiveChanged;
end;

end.
